VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "WOWapi"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' -----------------------------------------------------
' | Class: WOWApi
' | Purpose:  Used to import data from the wow API JSON endpoints
' |           available at XX.battle.net/API/wow where xx is the region
' | Author: Lenear
' | Revision: 1.0
' | Revision Date: 9-10-2011
' ----------------------------------------------------

' -------------------- Declarations---------------------

Private m_strRealm          As String  ' Holds the WOW realm used for lookups
Private m_strRegion         As String  ' Holds the region used for lookups
Private clsWeb              As New WebFunctions ' An instantiation of the WebFunctions class
Private wrkCurrent          As DAO.Workspace ' A workspace object to be used by all functions
Private db                  As DAO.Database ' A database object to be used by all functions


' ------------------- Properties -------------------------

Public Property Get Realm() As String
    Realm = m_strRealm
End Property
Public Property Let Realm(ByVal sContent As String)
    m_strRealm = sContent
End Property


Public Property Get Region() As String
    Realm = m_strRegion
End Property
Public Property Let Region(ByVal sContent As String)
    m_strRegion = sContent
End Property


' ------------------ Public Functions --------------------

Public Function importGuild(strGuild As String, Optional strRealm As String, Optional strRegion As String, Optional boolMembers As Boolean, Optional boolAchievements As Boolean) As Integer
 ' Queries the WOW API and imports / updates the provided guild information.  If the optional fields are provided, these will override the class values
On Error GoTo errHandler

Dim strRequest As String
Dim strJSON As String
Dim varResponse As Variant

Dim key As Variant
Dim mkey As Variant
Dim skey As Variant

Dim varMembers As Variant
Dim varAchievements As Variant
Dim varEmblem As Variant
Dim member As Variant
Dim varMember As Variant
Dim varCharacter As Variant

Dim intGID As Integer
Dim intCID As Integer
Dim intGrank As Integer

Dim rsGuild As DAO.Recordset
Dim rsCharacter As DAO.Recordset
Dim rsGuildLookup As DAO.Recordset


' determine values
    If strRealm = "" Then strRealm = m_strRealm
    If strRegion = "" Then strRegion = m_strRegion
    
    strRequest = "http://" + strRegion + ".battle.net/api/wow/guild/" + strRealm + "/" + clsWeb.URLEncode(strGuild) ' build the request
    
    If boolMembers = True Or boolAchievements = True Then
    strRequest = strRequest + "?fields="
        If boolMembers = True Then
            strRequest = strRequest + "members"
            If boolAchievements = True Then strRequest = strRequest + ",achievements"
        Else
            strRequest = strRequest + "achievements"
        End If
    End If
        
' Downloads the JSON from the Guild API

strJSON = clsWeb.getWebsite(strRequest)

'parse the reponse into a scripting.dictionary object
Set varResponse = clsWeb.JSON(strJSON)

Set rsGuild = db.OpenRecordset("Guild", dbOpenDynaset)
Set rsCharacter = db.OpenRecordset("Character", dbOpenDynaset)
Set rsGuildLookup = db.OpenRecordset("GuildLookup", dbOpenDynaset)

wrkCurrent.BeginTrans
rsGuild.AddNew

For Each key In varResponse

    Select Case key
    
        Case "lastModified", "realm", "level", "side", "achievementPoints"
            rsGuild.Fields(key) = varResponse(key)
           
        Case "name"
            rsGuild!gName = varResponse(key)
        Case "achievements"
            Set varAchievements = varResponse(key)
        Case "members"
            Set varMembers = varResponse(key)
        Case "emblem"
            Set varEmblem = varResponse(key)
    End Select
Next
intGID = rsGuild!ID
rsGuild.Update

If Not varMembers Is Nothing Then

    For Each key In varMembers
        DoEvents
        rsCharacter.AddNew
        If VarType(varMembers(key)) <> 9 Then
            Debug.Print varMembers(key)
        Else
            Set varMember = varMembers(key)
            For Each mkey In varMember
            
            Select Case mkey
                Case "character"
                    Set varCharacter = varMember(mkey)
                    For Each skey In varCharacter
                        If VarType(varCharacter(skey)) <> 9 Then
                            Select Case skey
                                Case "name"
                                    rsCharacter!cname = varCharacter(skey)
                                Case Else
                                    rsCharacter.Fields(skey) = varCharacter(skey)
                            End Select
                        End If
                    Next
                    
                Case "rank"
                   intGrank = varMember("rank")
            End Select
            
            Next
        End If
        
        intCID = rsCharacter!ID
        rsCharacter.Update
        
        rsGuildLookup.AddNew
        rsGuildLookup!GID = intGID
        rsGuildLookup!CID = intCID
        rsGuildLookup!rank = intGrank
        rsGuildLookup.Update
        
    Next

End If



importGuild = 1

wrkCurrent.CommitTrans

ExitHandler:

    Set varResponse = Nothing
    Set rsGuild = Nothing
    Set rsCharacter = Nothing

Exit Function

errHandler:

wrkCurrent.Rollback

    MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description

End Function

Public Function updateChar(intCID As Integer, Optional strRealm As String, Optional strRegion As String) As Integer

Dim strRequest As String
Dim strJSON As String
Dim strQuery As String
Dim varResponse As Variant
Dim intStat As Integer
Dim intItems As Integer
Dim intProgression As Integer

Dim key As Variant
Dim mkey As Variant
Dim skey As Variant

Dim varCharacter As Variant

Dim rsCharacter As DAO.Recordset

' determine values
    If strRealm = "" Then strRealm = m_strRealm
    If strRegion = "" Then strRegion = m_strRegion
    
strQuery = "Select * from Character where id = " + CStr(intCID)
Set rsCharacter = db.OpenRecordset(strQuery, dbOpenDynaset)

   If rsCharacter.RecordCount = 0 Then
      MsgBox "Characer Not Found"
      Exit Function
   End If
   
   strRequest = "http://" + strRegion + ".battle.net/api/wow/character/" + rsCharacter!Realm + "/" + rsCharacter!cname ' build the request
   strRequest = strRequest + "?fields=stats,items,achievements,talents,reputation,titles,professions,appearance,progression,pvp,quests"

' Downloads the JSON from the Character API

strJSON = clsWeb.getWebsite(strRequest)

'parse the reponse into a scripting.dictionary object
Set varResponse = clsWeb.JSON(strJSON)

wrkCurrent.BeginTrans
rsCharacter.Edit
For Each key In varResponse

If key = "status" Then
    If varResponse("status") = "nok" Then
        ' request error handling
        Debug.Print varResponse("reason")
        GoTo ExitHandler
    End If
End If

    Select Case key
                
' Process optional additional information groups
    Case "stats"
        intStat = updateStats(intCID, varResponse("stats"))
    Case "items"
        intItems = updateItems(intCID, varResponse("items"))
    Case "professions"
    Case "reputation"
    Case "titles"
    Case "achievements"
    Case "talents"
    Case "appearance"
    Case "progression"
        intProgression = updateProgression(intCID, varResponse("progression"))
    Case "pvp"
    Case "quests"
    
' Process Character Specific Attributes
    Case Else
    
        If VarType(varResponse(key)) <> 9 Then
            Select Case key
                Case "name"
                   rsCharacter!cname = varResponse(key)
                Case Else
                  rsCharacter.Fields(key) = varResponse(key)
                End Select
            End If
            
    End Select
    
Next

rsCharacter.Update

wrkCurrent.CommitTrans

ExitHandler:

    Set varResponse = Nothing
    Set rsCharacter = Nothing

Exit Function

errHandler:

wrkCurrent.Rollback

    MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description
    
    GoTo ExitHandler
    
End Function


' ------------------ Private Functions -------------------

Private Function updateStats(intCID As Integer, ByRef varStats As Variant) As Integer

Dim strQuery As String
Dim rsStats As DAO.Recordset
Dim key As Variant

strQuery = "Select * from [Character-Stats] where CID = " + CStr(intCID)
Set rsStats = db.OpenRecordset(strQuery, dbOpenDynaset)

   If rsStats.RecordCount = 0 Then
        rsStats.AddNew
    Else
        rsStats.Edit
   End If
   rsStats!CID = intCID
For Each key In varStats
        If VarType(varStats(key)) <> 9 Then
            rsStats.Fields(key) = varStats(key)
        End If
Next

rsStats.Update

End Function

Private Function updateItems(intCID As Integer, ByRef varItems As Variant) As Integer
On Error GoTo errHandler

Dim strQuery As String
Dim strToolTipField As String
Dim strSet As String

Dim rsItems As DAO.Recordset
Dim rsRefItem As DAO.Recordset
Dim rsTooltip As DAO.Recordset

Dim key As Variant
Dim item As Variant
Dim tooltip As Variant
Dim tipkey As Variant
Dim varSet As Variant
Dim skey As Variant

strQuery = "Select * from [Character-Items] where CID = " + CStr(intCID)
Set rsItems = db.OpenRecordset(strQuery, dbOpenDynaset)

   If rsItems.RecordCount = 0 Then
        rsItems.AddNew
    Else
        rsItems.Edit
   End If
   rsItems!CID = intCID
   
For Each key In varItems
        If VarType(varItems(key)) <> 9 Then
            rsItems.Fields(key) = varItems(key)
        Else
           Set item = varItems(key)
             
           rsItems.Fields(key) = item("id")
            If Not refExists(CLng(item("id")), "refItem") Then
                Set rsRefItem = db.OpenRecordset("select * from refItem where ID = " + CStr(item("id")), dbOpenDynaset)
                If rsRefItem.RecordCount = 0 Then
                    rsRefItem.AddNew
                Else
                    rsRefItem.Edit
                End If
                rsRefItem!ID = item("id")
                rsRefItem!itemName = item("name")
                rsRefItem!icon = item("icon")
                rsRefItem!quality = item("quality")
                rsRefItem.Update
                rsRefItem.Close
                
            End If
            
            Set tooltip = item("tooltipParams")
            If tooltip.Count > 0 Then
                strToolTipField = key + "TipID"
                If Nz(rsItems.Fields(strToolTipField)) > 0 Then
                    Set rsTooltip = db.OpenRecordset("select * from [Character-itemToolTip] where ID = " + CStr(rsItems.Fields(strToolTipField)), dbOpenDynaset)
                    rsTooltip.Edit
                Else
                    Set rsTooltip = db.OpenRecordset("select * from [Character-itemToolTip] where ID = 1", dbOpenDynaset)
                    rsTooltip.AddNew
                End If
                rsItems.Fields(strToolTipField) = rsTooltip!ID
                
                For Each tipkey In tooltip
                    If tipkey = "set" Then
                        
                        Set varSet = tooltip(tipkey)
                        For Each skey In varSet
                            strSet = strSet + CStr(varSet(skey)) + ";"
                        Next
                        rsTooltip.Fields("set") = strSet
                        strSet = ""
                        Set varSet = Nothing
                    Else
                         rsTooltip.Fields(tipkey) = tooltip(tipkey)
                                        
                    End If
                    
                    
                Next
                rsTooltip.Update
                rsTooltip.Close
                
            End If
        End If
        
Next
rsItems.Update
rsItems.Close

ExitHandler:

    Set rsItems = Nothing
    Set rsTooltip = Nothing
    Set rsRefItem = Nothing
    
    Exit Function
    
errHandler:

    Debug.Print key + ";" + tipkey + ";" + skey
    Debug.Print Err.Description + ";" + Err.Source
    
    GoTo ExitHandler

End Function
Private Function updateProgression(intCID As Integer, ByRef varProgression As Variant) As Integer
Dim strQuery As String
Dim lngRaidID As Long
Dim lngBossID As Long

Dim rsProgress As DAO.Recordset
Dim rsProgressBoss As DAO.Recordset
Dim rsRefInstance As DAO.Recordset
Dim rsRefBoss As DAO.Recordset

Dim key As Variant
Dim rKey As Variant
Dim bKey As Variant

Dim varRaids As Variant
Dim varBosses As Variant
Dim raid As Variant
Dim boss As Variant

For Each key In varProgression

    Select Case key
    
        Case "raids"
        
            Set varRaids = varProgression("raids")
            
            For Each rKey In varRaids
                
                Set raid = varRaids(rKey)
                lngRaidID = Int(raid("id"))
                strQuery = "select * from [character-progress] where CID = """ + CStr(intCID) + """ and instanceID = """ + CStr(lngRaidID) + """"
                Set rsProgress = db.OpenRecordset(strQuery, dbOpenDynaset)
                If rsProgress.RecordCount = 0 Then
                    rsProgress.AddNew
                    rsProgress!CID = intCID
                    rsProgress!instanceID = lngRaidID
                Else
                    rsProgress.Edit
                End If
                rsProgress!normalProgress = raid("normal")
                rsProgress!heroicProgress = raid("heroic")
                rsProgress.Update
                
                If Not refExists(CLng(lngRaidID), "refInstance") Then
                    Set rsRefInstance = db.OpenRecordset("select * from refInstance where ID = " + CStr(raid("id")), dbOpenDynaset)
                    If rsRefInstance.RecordCount = 0 Then
                        rsRefInstance.AddNew
                        rsRefInstance!instanceName = raid("name")
                        rsRefInstance!ID = lngRaidID
                        rsRefInstance.Update
                    End If
                End If
                
                Set varBosses = raid("bosses")
                    
                For Each bKey In varBosses
                    Set boss = varBosses(bKey)
                    lngBossID = boss("id")
                    strQuery = "select * from [character-progress-boss] where CID = """ + CStr(intCID) + """ and bossID = """ + CStr(lngBossID) + """"
                    Set rsProgressBoss = db.OpenRecordset(strQuery, dbOpenDynaset)
                    If rsProgressBoss.RecordCount = 0 Then
                        rsProgressBoss.AddNew
                    Else
                        rsProgressBoss.Edit
                    End If
                    
                        rsProgressBoss!CID = intCID
                        rsProgressBoss!BossID = lngBossID
                        rsProgressBoss!instanceID = lngRaidID
                        rsProgressBoss!normalKills = boss("normalKills")
                        rsProgressBoss!heroicKills = boss("heroicKills")
                        rsProgressBoss.Update
                        
                   If Not refExists(CLng(lngBossID), "refBoss") Then
                    Set rsRefBoss = db.OpenRecordset("select * from refBoss where ID = " + CStr(lngBossID), dbOpenDynaset)
                    If rsRefBoss.RecordCount = 0 Then
                        rsRefBoss.AddNew
                        rsRefBoss!ID = lngBossID
                        rsRefBoss!bossName = boss("name")
                        rsRefBoss!instanceID = lngRaidID
                        rsRefBoss.Update
                    End If
                   End If
                   
                Next
                
            Next
            
        Case Else
        ' Insert processing for other types of tracked progression....  (???)
        
    End Select
    

Next

End Function

Private Function refExists(refID As Long, refTable As String) As Boolean
On Error GoTo errHandler

Dim strQuery As String
Dim rsCheck As DAO.Recordset

strQuery = "Select * from " + refTable + " where ID = " + CStr(refID)

Set rsCheck = db.OpenRecordset(strQuery, dbOpenDynaset)

   If rsCheck.RecordCount = 0 Then
       refExists = False
   Else
       refExists = True
   End If

ExitHandler:

    Set rsCheck = Nothing
    
    Exit Function
    
errHandler:

    refExists = False
    
    GoTo ExitHandler
    
End Function



' ------------------ Events -------------------
Private Sub Class_Initialize()

Set wrkCurrent = DBEngine.Workspaces(0)
Set db = CurrentDb()

End Sub

Private Sub class_terminate()

Set wrkCurrent = Nothing
Set db = Nothing

End Sub
